home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / KREC.MOD < prev    next >
Text File  |  1987-09-29  |  22KB  |  553 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Do_Keyboard_Checks --- Check keyboard for activity            *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Do_Keyboard_Checks;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Do_Keyboard_Checks                                   *)
  10. (*                                                                      *)
  11. (*     Purpose:    Check keyboard for activity                          *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Do_Keyboard_Checks;                                           *)
  16. (*                                                                      *)
  17. (*     Calls:                                                           *)
  18. (*                                                                      *)
  19. (*        Async_Flush_Output_Buffer                                     *)
  20. (*        Handle_Function_Key                                           *)
  21. (*        Flip_Display_Status                                           *)
  22. (*        Write_To_Status_Line                                          *)
  23. (*        Print_Spooled_File                                            *)
  24. (*        Async_Send                                                    *)
  25. (*                                                                      *)
  26. (*----------------------------------------------------------------------*)
  27.  
  28. VAR
  29.    A_Ch : CHAR;
  30.  
  31. BEGIN (* Do_Keyboard_Checks *)
  32.                                    (* Pick up keyboard entry, if any.     *)
  33.    WHILE KeyPressed DO
  34.       BEGIN
  35.  
  36.          READ( Kbd, A_Ch );
  37.                                    (* If shift-tab, toggle transfer display *)
  38.  
  39.          IF ( ORD( A_Ch ) = ESC ) THEN
  40.             IF KeyPressed THEN
  41.                BEGIN
  42.  
  43.                   READ( Kbd, A_Ch );
  44.  
  45.                   IF ( ( ORD( A_Ch ) = ALT_R ) AND ( NOT Sending_File ) ) OR
  46.                      ( ( ORD( A_Ch ) = ALT_S ) AND (     Sending_File ) ) THEN
  47.                      A_Ch := ^K
  48.                   ELSE IF ( ORD( A_Ch ) = Shift_Tab ) THEN
  49.                      BEGIN
  50.                         Flip_Display_Status;
  51.                         A_Ch := CHR( 0 );
  52.                      END
  53.                   ELSE
  54.                      Handle_Function_Key( A_Ch );
  55.  
  56.                END
  57.             ELSE
  58.                IF Async_XOff_Received THEN
  59.                   BEGIN
  60.                      IF ( NOT Kermit_Do_Sliding_Win ) THEN
  61.                         Async_Flush_Output_Buffer;
  62.                      Async_XOff_Received := FALSE;
  63.                      IF Do_Status_Line THEN
  64.                         Write_To_Status_Line( '             ', 65 );
  65.                   END;
  66.  
  67.          CASE A_Ch OF
  68.  
  69.             ^B:  BEGIN    (* Cancel current batch of files *)
  70.                     Kermit_Abort       := TRUE;
  71.                     Kermit_Abort_Level := All_Files;
  72.                  END;
  73.  
  74.             ^F:  BEGIN    (* Cancel current file *)
  75.                     Kermit_Abort       := TRUE;
  76.                     Kermit_Abort_Level := One_File;
  77.                  END;
  78.  
  79.             ^K:  BEGIN    (* Drop out of Kermit entirely *)
  80.                     Kermit_Abort       := TRUE;
  81.                     Kermit_Abort_Level := Entire_Protocol;
  82.                  END;
  83.  
  84.             ^M,
  85.             ^R:  BEGIN    (* Retry current packet *)
  86.                     Kermit_Retry       := TRUE;
  87.                     Async_Send( CHR( CR ) );
  88.                  END;
  89.  
  90.             ELSE;
  91.  
  92.          END (* CASE *);
  93.  
  94.       END;
  95.                                    (* Print character from spooled file *)
  96.    IF Print_Spooling THEN
  97.       Print_Spooled_File;
  98.                                    (* If carrier dropped, quit *)
  99.  
  100.    IF ( NOT Async_Carrier_Detect ) THEN
  101.       BEGIN
  102.          Kermit_Abort       := TRUE;
  103.          Kermit_Abort_Level := Entire_Protocol;
  104.       END;
  105.  
  106. END   (* Do_Keyboard_Checks *);
  107.  
  108. (*----------------------------------------------------------------------*)
  109. (*             Get_Char --- Get character for Kermit packet             *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. PROCEDURE Get_Char( VAR Ch : INTEGER );
  113.  
  114. (*----------------------------------------------------------------------*)
  115. (*                                                                      *)
  116. (*     Procedure:  Get_Char                                             *)
  117. (*                                                                      *)
  118. (*     Purpose:    Gets character for Kermit packet                     *)
  119. (*                                                                      *)
  120. (*     Calling Sequence:                                                *)
  121. (*                                                                      *)
  122. (*        Get_Char( VAR Ch: INTEGER );                                  *)
  123. (*                                                                      *)
  124. (*           Ch --- returned character                                  *)
  125. (*                                                                      *)
  126. (*     Calls:                                                           *)
  127. (*                                                                      *)
  128. (*        Async_Receive_With_TimeOut                                    *)
  129. (*        Async_Flush_Output_Buffer                                     *)
  130. (*        Handle_Function_Key                                           *)
  131. (*        Flip_Display_Status                                           *)
  132. (*        Write_To_Status_Line                                          *)
  133. (*        Print_Spooled_File                                            *)
  134. (*        Async_Send                                                    *)
  135. (*                                                                      *)
  136. (*----------------------------------------------------------------------*)
  137.  
  138. VAR
  139.    Temp          : INTEGER;
  140.    Rec_Stat_Flag : BOOLEAN;
  141.    A_Ch          : CHAR;
  142.    ITimer        : INTEGER;
  143.  
  144. BEGIN (* Get_Char *)
  145.  
  146.    Temp               := 0;
  147.    Kermit_Abort       := FALSE;
  148.    Kermit_Retry       := FALSE;
  149.    Rec_Stat_Flag      := FALSE;
  150.    Kermit_Abort_Level := No_Abort;
  151.  
  152.                                    (* Do fast check for character *)
  153.                                    (* available before doing long *)
  154.                                    (* check.                      *)
  155.  
  156.    IF ( Async_Buffer_Head <> Async_Buffer_Tail ) THEN
  157.       BEGIN
  158.          Rec_Stat_Flag := Async_Receive( A_Ch );
  159.          Ch            := ORD( A_Ch );
  160.          EXIT;
  161.       END;
  162.                                    (* Loop until char found from *)
  163.                                    (* comm port or keyboard      *)
  164.    REPEAT
  165.                                    (* Pick up a character from comm port, *)
  166.                                    (* if any.                             *)
  167.       ITimer := 0;
  168.                                    (* Break up timeout into 1-sec pieces  *)
  169.       REPEAT
  170.                                    (* Pick up a character                 *)
  171.          ITimer := SUCC( ITimer );
  172.  
  173.          Async_Receive_With_TimeOut( 1 , Ch );
  174.  
  175.                                    (* If we timed out, indicate retry *)
  176.                                    (* should be done.                 *)
  177.          IF ( Ch = TimeOut ) THEN
  178.             BEGIN
  179.                Kermit_Retry  := ( ITimer > His_TimeOut );
  180.                Rec_Stat_Flag := FALSE;
  181.                Ch            := 0;
  182.             END
  183.          ELSE
  184.             Rec_Stat_Flag := TRUE;
  185.  
  186.       UNTIL( Rec_Stat_Flag OR Kermit_Retry );
  187.  
  188.    UNTIL ( Rec_Stat_Flag OR Kermit_Abort OR Kermit_Retry );
  189.  
  190.                                    (* Make sure to check for carrier *)
  191.                                    (* drop if we timed out.          *)
  192.    IF Kermit_Retry THEN
  193.       Do_Keyboard_Checks;
  194.  
  195. END   (* Get_Char *);
  196.  
  197. (*----------------------------------------------------------------------*)
  198. (*                Receive_Packet --- Receive Kermit packet              *)
  199. (*----------------------------------------------------------------------*)
  200.  
  201. PROCEDURE Receive_Packet;
  202.  
  203. (*----------------------------------------------------------------------*)
  204. (*                                                                      *)
  205. (*     Procedure:  Receive_Packet                                       *)
  206. (*                                                                      *)
  207. (*     Purpose:    Gets Kermit packet                                   *)
  208. (*                                                                      *)
  209. (*     Calling Sequence:                                                *)
  210. (*                                                                      *)
  211. (*        Receive_Packet;                                               *)
  212. (*                                                                      *)
  213. (*     Calls:                                                           *)
  214. (*                                                                      *)
  215. (*        Get_Char                                                      *)
  216. (*        Get_P_Length                                                  *)
  217. (*        Kermit_Chk8                                                   *)
  218. (*        Kermit_Chk12                                                  *)
  219. (*        Kermit_CRC                                                    *)
  220. (*                                                                      *)
  221. (*     Remarks:                                                         *)
  222. (*                                                                      *)
  223. (*        A Kermit packet starts with an SOH character, followed by a   *)
  224. (*        packet length, then the block number MOD 64, then the packet  *)
  225. (*        data, and finally a checksum or crc.                          *)
  226. (*                                                                      *)
  227. (*----------------------------------------------------------------------*)
  228.  
  229. VAR
  230.    Rec_Char          : INTEGER;
  231.    B_Rec_Char        : BYTE;
  232.    Temp              : INTEGER;
  233.    Check_Char        : CHAR;
  234.    Check_OK          : BOOLEAN;
  235.    CheckSum          : INTEGER;
  236.    Count             : INTEGER;
  237.    Index             : INTEGER;
  238.    StrNum            : STRING[3];
  239.    Chk1              : CHAR;
  240.    Chk2              : CHAR;
  241.    Chk3              : CHAR;
  242.    Check_Type        : INTEGER;
  243.    L_Packet          : INTEGER;
  244.    Rec_Pos           : INTEGER;
  245.    Echoed_Packet     : BOOLEAN;
  246.    Long_Packet       : BOOLEAN;
  247.    Long_Packet_Found : BOOLEAN;
  248.    Packet_For_Debug  : AnyStr;
  249.  
  250. (*----------------------------------------------------------------------*)
  251. (*             Get_P_Length --- Get length of Kermit packet             *)
  252. (*----------------------------------------------------------------------*)
  253.  
  254. FUNCTION Get_P_Length : BOOLEAN;
  255.  
  256. BEGIN (* Get_P_Length *)
  257.  
  258.    Get_P_Length      := TRUE;
  259.    Long_Packet       := FALSE;
  260.    Long_Packet_Found := FALSE;
  261.    L_Packet          := 0;
  262.                                    (* If next char is not SOH, it must *)
  263.                                    (* be length.  If 0, then this is a *)
  264.                                    (* long packet.                     *)
  265.  
  266.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  267.       BEGIN
  268.          Get_Char( Rec_Char );
  269.          IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
  270.             BEGIN
  271.                Get_P_Length := FALSE;
  272.                Count        := 2000;
  273.             END
  274.          ELSE
  275.             BEGIN
  276.                                    (* Get packet length *)
  277.  
  278.                Count    := Rec_Char - 32;
  279.                L_Packet := Count;
  280.  
  281.                                    (* If length is zero, prepare to   *)
  282.                                    (* process long (>94 chars) packet *)
  283.  
  284.                IF ( Count = 0 ) THEN
  285.                   BEGIN
  286.                      Long_Packet       := TRUE;
  287.                      Long_Packet_Found := TRUE;
  288.                      Count             := 5;
  289.                   END;
  290.  
  291.             END
  292.       END
  293.    ELSE
  294.       Count := 0;
  295.  
  296.    Do_Keyboard_Checks;
  297.  
  298. END (* Get_P_Length *);
  299.  
  300. (*----------------------------------------------------------------------*)
  301. (*                Get_The_Packet --- Get Kermit packet                  *)
  302. (*----------------------------------------------------------------------*)
  303.  
  304. PROCEDURE Get_The_Packet;
  305.  
  306. VAR
  307.    I: INTEGER;
  308.  
  309. BEGIN (* Get_The_Packet *)
  310.                                    (* Wait for header character (SOH) *)
  311.  
  312.    REPEAT  (* get header character *)
  313.       Get_Char( Rec_Char );
  314.       Do_Keyboard_Checks;
  315.    UNTIL ( ( Rec_Char = ORD( Kermit_Header_Char ) ) OR
  316.             Kermit_Abort OR Kermit_Retry );
  317.  
  318.                                    (* Initialize packet *)
  319.  
  320.    Rec_Packet_Ptr     := ADDR( Sector_Data );
  321.    Rec_Pos            := 1;
  322.    Check_OK           := FALSE;
  323.    Packet_OK          := FALSE;
  324.    Echoed_Packet      := FALSE;
  325.    Check_Type         := ORD( His_Chk_Type ) - ORD('0');
  326.    CheckSum           := 0;
  327.    Kermit_Packet_Type := Unknown;
  328.  
  329.                                    (* Get packet length *)
  330.    WHILE ( NOT Get_P_Length ) DO
  331.       Rec_Pos := 1;
  332.                                    (* Get rest of packet *)
  333.  
  334.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  335.       BEGIN (* NOT ( Abort OR Retry ) *)
  336.          REPEAT
  337.                                    (* Packet type and data *)
  338.             Get_Char( Rec_Char );
  339.  
  340.             IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
  341.                BEGIN  (* got new start of packet *)
  342.  
  343.                                    (* Packet is initially empty *)
  344.                   REPEAT
  345.                      Rec_Pos        := 1;
  346.  
  347.                   UNTIL Get_P_Length OR Kermit_Abort OR Kermit_Retry;
  348.  
  349.                END
  350.             ELSE  (* must be a character *)
  351.                BEGIN
  352.                   Rec_Pos                  := SUCC( Rec_Pos );
  353.                   Rec_Packet_Ptr^[Rec_Pos] := CHR( Rec_Char );
  354.                   Count                    := PRED( Count );
  355.                END;
  356.  
  357.                                    (* If long packet and count is 0, *)
  358.                                    (* process extended length and    *)
  359.                                    (* keep on going.                 *)
  360.  
  361.             IF ( ( Count = 0 ) AND Long_Packet ) THEN
  362.                BEGIN
  363.  
  364.                   CheckSum := 32 + ORD( Rec_Packet_Ptr^[2] ) +
  365.                                    ORD( Rec_Packet_Ptr^[3] ) +
  366.                                    ORD( Rec_Packet_Ptr^[4] ) +
  367.                                    ORD( Rec_Packet_Ptr^[5] );
  368.  
  369.                   CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  370.  
  371.                   Chk1     := CHR( CheckSum + 32 );
  372.  
  373.                   Check_OK := ( Chk1 = Rec_Packet_Ptr^[ 6 ] );
  374.  
  375.                                    (* If checksum on lengths bad,        *)
  376.                                    (* set up to flush packet and return, *)
  377.                                    (* else get extended length.          *)
  378.  
  379.                   IF ( NOT Check_OK ) THEN
  380.                      BEGIN
  381.                         Packet_OK          := FALSE;
  382.                         Packets_Received   := Packets_Received + 1;
  383.                         Update_Kermit_Display;
  384.                         Kermit_Packet_Type := Unknown;
  385.                         EXIT;
  386.                      END
  387.                   ELSE
  388.                      BEGIN
  389.                         Count       := 95 * ( ORD( Rec_Packet_Ptr^[4] ) - 32 ) +
  390.                                             ( ORD( Rec_Packet_Ptr^[5] ) - 32 );
  391.                         Long_Packet := FALSE;
  392.                      END;
  393.  
  394.                END;
  395.  
  396.          UNTIL ( Kermit_Abort    OR
  397.                  Kermit_Retry    OR
  398.                  ( ( Count = 0 ) AND ( NOT Long_Packet ) ) );
  399.  
  400.                                    (* Check for keyboard input *)
  401.       Do_Keyboard_Checks;
  402.                                    (* Store length of packet  *)
  403.  
  404.       Rec_Packet_Length  := Rec_Pos;
  405.       Rec_Packet_Ptr^[1] := CHR( L_Packet + 32 );
  406.  
  407.                                    (* Check if this looks like an *)
  408.                                    (* echoed packet               *)
  409.  
  410.       IF ( ( Rec_Packet_Ptr^[2] = Send_Packet_Ptr^[3] ) AND
  411.            ( Rec_Packet_Ptr^[3] = Send_Packet_Ptr^[4] ) ) THEN
  412.          BEGIN
  413.             Echoed_Packet := TRUE;
  414.             EXIT;
  415.          END;
  416.                                    (* Update packets received *)
  417.  
  418.       Packets_Received := Packets_Received + 1;
  419.  
  420.                                    (* Update display *)
  421.       Update_Kermit_Display;
  422.  
  423.       IF ( NOT Kermit_Abort ) THEN
  424.          BEGIN  (* NOT Abort *)
  425.                                    (* Compute and check checksum or crc *)
  426.  
  427.             CASE His_Chk_Type OF
  428.  
  429.                '1': BEGIN
  430.  
  431.                        Kermit_Chk8( Rec_Packet_Ptr^,
  432.                                     Rec_Packet_Length - 1,
  433.                                     CheckSum );
  434.  
  435.                        CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  436.  
  437.                        Chk1     := CHR( CheckSum + 32 );
  438.  
  439.                        Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length ] );
  440.  
  441.                     END;
  442.  
  443.                '2': BEGIN
  444.  
  445.                        Kermit_Chk12( Rec_Packet_Ptr^,
  446.                                      Rec_Packet_Length - 2,
  447.                                      CheckSum );
  448.  
  449.                        Chk1 := CHR( CheckSum SHR 6  + 32 );
  450.                        Chk2 := CHR( CheckSum AND 63 + 32 );
  451.  
  452.                        Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length - 1 ] ) AND
  453.                                    ( Chk2 = Rec_Packet_Ptr^[ Rec_Packet_Length     ] );
  454.  
  455.                    END;
  456.  
  457.               '3': BEGIN
  458.  
  459.                       Kermit_CRC( Rec_Packet_Ptr^,
  460.                                   Rec_Packet_Length - 3,
  461.                                   CheckSum );
  462.  
  463.                       Chk1 := CHR( ( CheckSum SHR 12 ) AND 63  + 32 );
  464.                       Chk2 := CHR( ( CheckSum SHR 6  ) AND 63  + 32 );
  465.                       Chk3 := CHR( CheckSum AND 63             + 32 );
  466.  
  467.                       Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length - 2 ] ) AND
  468.                                   ( Chk2 = Rec_Packet_Ptr^[ Rec_Packet_Length - 1 ] ) AND
  469.                                   ( Chk3 = Rec_Packet_Ptr^[ Rec_Packet_Length     ] );
  470.  
  471.                   END;
  472.  
  473.             END (* CASE *);
  474.                                    (* Get packet number *)
  475.  
  476.             Rec_Packet_Num := ORD( Rec_Packet_Ptr^[2] ) - 32;
  477.  
  478.                                    (* Set next state based upon packet type *)
  479.  
  480.             CASE Rec_Packet_Ptr^[3] OF
  481.                'A' : Kermit_Packet_Type := Attrib_Pack;
  482.                'B' : Kermit_Packet_Type := Break_Pack;
  483.                'D' : Kermit_Packet_Type := Data_Pack;
  484.                'E' : Kermit_Packet_Type := Error_Pack;
  485.                'F' : Kermit_Packet_Type := Header_Pack;
  486.                'G' : Kermit_Packet_Type := Generic_Pack;
  487.                'H' : Kermit_Packet_Type := Host_Pack;
  488.                'N' : Kermit_Packet_Type := NAK_Pack;
  489.                'S' : Kermit_Packet_Type := Send_Pack;
  490.                'T' : Kermit_Packet_Type := Reserved_Pack;
  491.                'X' : Kermit_Packet_Type := Text_Pack;
  492.                'Y' : Kermit_Packet_Type := ACK_Pack;
  493.                'Z' : Kermit_Packet_Type := End_Pack;
  494.                ELSE  Kermit_Packet_Type := Unknown;
  495.             END (* CASE *);
  496.                                    (* Strip type, #, checksum from packet *)
  497.  
  498.             IF Long_Packet_Found THEN
  499.                Index := 6
  500.             ELSE
  501.                Index := 3;
  502.  
  503.             IF ( Rec_Packet_Length > ( Check_Type + Index ) ) THEN
  504.                BEGIN
  505.                   Rec_Packet_Ptr    := ADDR( Rec_Packet_Ptr^[Index + 1] );
  506.                   Rec_Packet_Length := Rec_Packet_Length - Check_Type - Index;
  507.                END;
  508.                                     (* Set flag if packet OK *)
  509.  
  510.             IF ( Check_OK AND ( Kermit_Packet_Type <> Unknown ) ) THEN
  511.                Packet_OK := TRUE;
  512.  
  513.          END  (* NOT Abort *);
  514.  
  515.       END  (* NOT ( Abort OR Retry ) *);
  516. {
  517.    IF Kermit_Debug THEN
  518.       BEGIN
  519.          Packet_For_Debug := '<';
  520.          MOVE( Rec_Packet_Ptr^[1], Packet_For_Debug[2], Rec_Packet_Length );
  521.          Packet_For_Debug[0] := CHR( Rec_Packet_Length + 1 );
  522.          Packet_For_Debug := Packet_For_Debug + '>';
  523.          Write_Log( '----- Get_The_Packet -----', FALSE, FALSE );
  524.          Write_Log( Packet_For_Debug, TRUE, FALSE );
  525.          Write_Log( 'Rec_Packet_Length = ' + IToS( Rec_Packet_Length ), TRUE, FALSE );
  526.          Write_Log( 'Rec_Packet_Number = ' + IToS( Rec_Packet_Num    ), TRUE, FALSE );
  527.          IF Echoed_Packet THEN
  528.             Write_Log( 'Echoed packet', TRUE, FALSE )
  529.          ELSE
  530.             Write_Log( 'Not echoed packet', TRUE, FALSE );
  531.          IF Kermit_Retry THEN
  532.             Write_Log( 'Retry set', TRUE, FALSE )
  533.          ELSE
  534.             Write_Log( 'Retry not set', TRUE, FALSE );
  535.          Write_Log( '------------------', FALSE, FALSE );
  536.       END;
  537. }
  538.  
  539. END   (* Get_The_Packet *);
  540.  
  541. (*----------------------------------------------------------------------*)
  542.  
  543. BEGIN (* Receive_Packet *)
  544.                                    (* Get a packet *)
  545.    Get_The_Packet;
  546.                                    (* If this appears to be an echoed *)
  547.                                    (* packet, try again.              *)
  548.  
  549.    IF Echoed_Packet AND ( NOT Kermit_Abort OR Kermit_Retry ) THEN
  550.       Get_The_Packet;
  551.  
  552. END   (* Receive_Packet *);
  553.